home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
sunrset.src
< prev
next >
Wrap
Text File
|
1990-10-18
|
2KB
|
89 lines
%%HP: T(3)A(D)F(.);
@ by Charles Kluepfel
DIR
SRSS
\<< "Alt " ALT \->STR + 2 DISP ANLMA "Lat " LAT \->STR + " Dlo " +
DLONG \->STR + 1 DISP DLONG + \-> D EQT
\<< 'ACOS(( SIN(ALT)-SIN(LAT)* SIN(D))/(COS(LAT)* COS(D)))' EVAL
\-> HA
\<< EQT HA - D\->T EQT HA + D\->T AKEY DROP
\>>
\>>
\>>
ANLMA
\<< \-> MO DA
\<< DEG DAT 1 MO PUTI DA PUT LIST\-> DROP INDAT JD 2451545 -
.98564733 * DUP 280.47 + SWAP 2.47 - \-> RAMS M
\<< 'RAMS +1.91*SIN(M)' EVAL RAMS \->DRA
\>>
\>>
\>>
INDAT
\<< 3 \->LIST DUP \->JD DUP 'JD' STO J\->DOW SWAP 1 GETI 3 ROLLD GET
\-> DW M D
\<<
IF M 4 > M 10 < AND M 4 == D DW \>= AND OR M 10 == D 23 DW + \<=
AND OR
THEN DL1 'DLONG' STO
ELSE DL0 'DLONG' STO
END
\>>
\>>
GC 13
LAT 40.75
DL0 -1
DL1 14
ALT -.75
JD 2448248
DLONG -1
DAT
\<< JD JD\->
\>>
\->DRA
\<< \-> L RAMS
\<< 'ASIN( SIN(L)*.397)' EVAL \-> D
\<< 'ACOS (COS(L)/COS(D))' EVAL L SIN SGN * RAMS - NOR D SWAP
\>>
\>>
\>>
\->JD
\<< 1 3 SUB LIST\-> DROP \-> M D Y
\<< Y M
IF M 2 \<=
THEN 12 + SWAP 1 - SWAP
END 1 + 30.6001 * IP SWAP DUP 100 / FLOOR DUP 4 / FLOOR - 2 - 'GC' STO
365.25 * FLOOR + D + GC - 1720995 +
\>>
\>>
JD\->
\<< \-> JD
\<< JD 1867216.25 - 36524.25 / FLOOR DUP 4 / FLOOR - 1 + 'GC' STO JD GC +
1524 + \-> B
\<< 'FLOOR((B -122.1)/365.25)' EVAL \-> C
\<< 'FLOOR( 365.25*C)' EVAL \-> D
\<< ' FLOOR((B-D)/30.6001 )' EVAL \-> E
\<< IF E 13 \<= THEN E 1 - ELSE E 13 - END B D - E 30.6001 *
FLOOR - IF OVER 3 \>= THEN C 4716 - ELSE C 4715 - END 3 \->LIST
\>>
\>>
\>>
\>>
\>>
\>>
AKEY \<<
DO KEY
UNTIL 0 \=/
END \>>
J\->DOW
\<< 1 + 7 MOD 1 + \>>
D\->T
\<< 4 * 720.5 + FLOOR 60 QREM 100 + STD \->STR 2 3 SUB SWAP \->STR 58 CHR +
SWAP +
\>>
QREM \<< DUP2 / FLOOR ROT ROT MOD \>>
NOR
\<< 1 ASIN 2 * DUP DUP 2 * SWAP 4 ROLL + SWAP MOD SWAP - \>>
SGN
\<< SIGN .5 + SIGN \>>
END